home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 1.iso / ARGONET / PD / MATHS / RLAB / RLAB125.ZIP / !RLaB / rlib / printmat < prev    next >
Text File  |  1995-03-13  |  3KB  |  141 lines
  1. //--------------------------------------------------------------------------------
  2. // printmat
  3.  
  4. // Synopsis: Print a matrix with title and labels.
  5.  
  6. // Syntax: printmat(A, Aname, ROWLAB, COLLAB);
  7.  
  8. // Description:
  9.  
  10. // This routine prints the matrix A using the title contained in the
  11. // string Aname and the row labels contained in ROWLAB and the
  12. // column labels contained in COLLAB. Note: ROWLAB and COLLAB are
  13. // vectors of strings, such as
  14. //
  15. //         rowlab[1]="alpha";
  16. //         rowlab[2]="beta";
  17. //         rowlab[3]="gamma";
  18. //
  19. //  Note: Aname, ROWLAB, and COLLAB are optional variables.
  20. //
  21. //--------------------------------------------------------------------------------
  22.  
  23. printmat = function (a, mname, rowlab, collab, fn)
  24. {
  25.   // Set defaults, error check.
  26.  
  27.   if (!exist (a)) { error ("printmat: must supply a matrix"); }
  28.   if (!exist (mname)) { mname = ""; }
  29.   if (!exist (rowlab)) { rl = []; else rl = rowlab; }
  30.   if (!exist (collab)) { cl = []; else cl = collab; }
  31.   if (!exist (fn))     { fn = "stdout"; }
  32.   
  33.   if (!isempty (rl)) {
  34.     if (rl.n != a.nr) { error ("printmat: ROWLAB.n != A.nr"); }
  35.   }
  36.   if (!isempty (cl)) {
  37.     if (cl.n != a.nc) { error ("printmat: COLLAB.n != A.nc"); }
  38.   }
  39.  
  40.   nrows=a.nr;
  41.   ncols=a.nc;
  42.   
  43.   // Create row and column labels if necessary
  44.   if (rl.n == 0)
  45.   {
  46.     for (i in 1:nrows) 
  47.     {
  48.       sprintf (tmp, "%3i", i);
  49.       rl[i]="--"+ tmp +" --> ";
  50.     }
  51.   }
  52.   if (cl.n == 0)
  53.   {   
  54.     for (i in 1:ncols) { cl[i]="----"+int2str(i)+"---- "; }
  55.   }
  56.   
  57.   col_per_scrn=5;
  58.   len=12;
  59.   
  60.   if ((nrows==0)||(ncols==0)) 
  61.   { 
  62.     if (length (mname)) 
  63.     {
  64.       fprintf(fn," \n%s = \n \n",mname);
  65.       return 0;
  66.     }
  67.     fprintf(fn," \n%s \n","     [] \n");
  68.     return 0;
  69.   }
  70.  
  71.   // Print matrix name
  72.   col=1;
  73.   n = min([col_per_scrn-1,ncols-1]);
  74.   if (length (mname)) 
  75.   {
  76.     fprintf(fn,"\n%s = \n \n",mname);
  77.   }
  78.  
  79.   // Print column labels
  80.   s="";
  81.   icol=0;
  82.   while (col <= ncols) 
  83.   {
  84.     icol=icol+1;
  85.     s="            ";
  86.     for (j in 0:n) 
  87.     {
  88.       ishift=13-length(cl[j+col]);
  89.       for (k in 1:ishift) 
  90.       {
  91.     s=s+" ";
  92.       }
  93.       s=s+cl[j+col];
  94.     }
  95.     fprintf(fn,"%s\n",s);
  96.     
  97.     // Print Row Labels
  98.     for (i in 1:nrows) 
  99.     {
  100.       s=""+rl[i];
  101.       ishift=12-length(rl[i]);
  102.       for (k in 1:ishift) 
  103.       {
  104.     s=s+" ";
  105.       }
  106.       for (j in 0:n) 
  107.       {
  108.     element = a[i;col+j];
  109.     if (element == 0) {
  110.       s=s+"           0";
  111.     else if (element >= 1.0e+06) {
  112.       sdum="";
  113.       sprintf(sdum," %12.5e",element);
  114.       s=s+sdum;
  115.     else if (element <= -1.0e+05) {
  116.       sdum="";
  117.       sprintf(sdum," %12.5e",element);
  118.       s=s+sdum;
  119.     else if (abs(element) < 0.0001) {
  120.       sdum="";
  121.       sprintf(sdum," %12.5e",element);
  122.       s=s+sdum;
  123.     else
  124.       sdum="";
  125.       sprintf(sdum," %12.5f",element);
  126.       s=s+sdum;
  127.         } } } }
  128.       }
  129.       fprintf(fn,"%s\n",s);
  130.     }
  131.     col = col+col_per_scrn;
  132.     fprintf(fn,"%s"," \n");
  133.     if ((ncols-col) < n) 
  134.     {
  135.       n=ncols-col;
  136.     }
  137.   }
  138.   
  139.   return 0;  
  140. };
  141.